home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 6 / The Arsenal Files 6 (Arsenal Computer).ISO / prg_basi / loadname.zip / LOADNAME.BAS < prev   
BASIC Source File  |  1996-03-27  |  9KB  |  225 lines
  1. '***********************************************************************
  2. '* FILE LOADNAME.BAS
  3. '*    Released 27 Mar 1996.
  4. '*
  5. '* PURPOSE
  6. '*    Demonstrates loading filenames into an array by calling DOS ISR
  7. '*    21H, Function 1AH (DOS set DTA Service), Function 4EH (Find First
  8. '*    Matching Name), and Function 4FH (Find Next Matching Name).
  9. '*
  10. '* NOTE
  11. '*    This code is for QuickBASIC which does not offer a way to
  12. '*    dynamically re-size an array without losing the contents (ala
  13. '*    PDS's REDIM PRESERVE).  Therefore, SUB LoadNames first calls
  14. '*    FUNCTION FileCnt% to get a count of the matching filenames (to
  15. '*    determine the number of elements to which to dimension the
  16. '*    filename array).
  17. '*
  18. '*    However, the observant will notice that much of the code in
  19. '*    FUNCTION FileCnt% is duplicated in SUB LoadNames.  If you have
  20. '*    PDS, you can modify SUB LoadNames to use REDIM PRESERVE to
  21. '*    dynamically "grow" the array, rather than having to first call
  22. '*    FUNCTION FileCnt% to find out how many files match the given
  23. '*    filespec.
  24. '*
  25. '* WARRANTY
  26. '*    Joe Negron disclaims all warranties regarding this software,
  27. '*    whether express or implied, including, but not limited to,
  28. '*    warranties of merchantability, fitness for a particular purpose,
  29. '*    or functionality.
  30. '*
  31. '* LICENSE AGREEMENT
  32. '*    This source code is released to the Public Domain.  However, an
  33. '*    acknowledgement in your documentation will be appreciated.  You
  34. '*    may also, as a further courtesy, give me a registered copy of the
  35. '*    program in which this code is used; please leave me a message (see
  36. '*    CONTACTING THE AUTHOR) should you decide to do this.
  37. '*
  38. '*    I encourage those to whom this code proves useful (and those to
  39. '*    whom it does not) to consider making a donation to their preferred
  40. '*    charity.
  41. '*
  42. '* ACKNOWLEDGEMENTS
  43. '*    My wife, Ana, for allowing me to spend countless hours at the PC.
  44. '*
  45. '* CONTACTING THE AUTHOR
  46. '*    If you have any comments, constructive criticism, bug fixes or
  47. '*    enhancements to offer, you may communicate with me in a variety
  48. '*    of ways (in order of preference):
  49. '*
  50. '*       1. If you have access to FidoNet NetMail, route or crash a
  51. '*          message to Joe Negron at 1:278/216.
  52. '*
  53. '*       2. Log onto my BBS:
  54. '*
  55. '*             The Programmer's Mark BBS, 1:278/216@fidonet
  56. '*                (718) 921-9267
  57. '*                Brooklyn, NY, USA
  58. '*                Joe Negron, Sysop
  59. '*                John Bragazzi, Co-Sysop
  60. '*                Running Maximus/2 v3.01
  61. '*                Available 24 hours/day, 7 days/wk
  62. '*
  63. '*          and leave a message in message area JNEGRON, Support for Joe
  64. '*          Negron Products.
  65. '*
  66. '*       3. If you have access to the Internet, leave a message,
  67. '*          addressed to "joe.negron@consultant.com".
  68. '*
  69. '*       4. Via snail mail:
  70. '*
  71. '*             Joe Negron
  72. '*             P.O. Box 09546
  73. '*             Fort Hamilton Station
  74. '*             Brooklyn, NY  11209
  75. '***********************************************************************
  76. DEFINT A-Z
  77.  
  78. DECLARE SUB LoadNames (FileSpec$, Array$(), Attr%)
  79.  
  80. DECLARE FUNCTION FileCnt% (FileSpec$, Attr%)
  81.  
  82. '$INCLUDE: 'qb.bi'                           'Needed for Interrupt call
  83.  
  84. TYPE DTARec                                  'used by Find First/Next
  85.    Reserved  AS STRING * 21
  86.    Attr      AS STRING *  1
  87.    NotNeeded AS STRING *  8                  'Time/date/size (unneeded)
  88.    FileName  AS STRING * 13
  89. END TYPE
  90.  
  91. DIM SHARED DTA AS DTARec                     'SHARED lets both SUB
  92. DIM SHARED RegsX AS RegTypeX                 '  LoadNames and FUNCTION
  93.                                              '  FileCnt% access them.
  94.                                              'Use COMMON SHARED to allow
  95.                                              '  access from multiple
  96.                                              '  modules
  97. REDIM FileName$(1 TO 1)                      'Create a dynamic arrray
  98.  
  99. Spec$ = "C:\*.*"                             'Load filenames matching
  100.                                              '  this filespec
  101.  
  102. 'Note: this code does NOT return files with
  103. 'the Hidden, System, or Read-Only attributtes
  104. Attr% = 16                                   'Directories only
  105. Attr% = 32                                   'Files only
  106. Attr% = 48                                   'Files and Directories
  107. LoadNames Spec$, FileName$(), Attr%
  108.  
  109. 'Show what we've found
  110. IF FileName$(1) = "" THEN
  111.    PRINT "No matching files"
  112. ELSE
  113.    FOR I% = 1 TO UBOUND(FileName$)
  114.       PRINT USING "###: \           \"; I%; FileName$(I%)
  115.    NEXT I%
  116. END IF
  117.  
  118. END
  119.  
  120. '***********************************************************************
  121. '* FUNCTION FileCnt%
  122. '*
  123. '* PURPOSE
  124. '*    Uses DOS ISR 21H, Function 1AH (DOS set DTA Service), Function 4EH
  125. '*    (Find First Matching Name), and Function 4FH (Find Next Matching
  126. '*    Name) to obtain a count of files matching FileSpec$.
  127. '***********************************************************************
  128. FUNCTION FileCnt% (FileSpec$, Attr%) STATIC
  129.    RegsX.dx = VARPTR(DTA)                    'Set new DTA address
  130.    RegsX.ds = -1                             'DTA is in DGROUP
  131.    RegsX.ax = &H1A00                         'Set DTA
  132.    InterruptX &H21, RegsX, RegsX             'Call DOS
  133.  
  134.    Count% = 0                                'Initialize counter
  135.  
  136.    FBuff$ = FileSpec$ + CHR$(0)              'Needs to be ASCIIZ string
  137.  
  138.    RegsX.cx = Attr%                          'Files matching Attr%
  139.    RegsX.dx = SADD(FBuff$)                   'FBuff$'s address
  140.    RegsX.ds = -1                             'For QuickBASIC, segment is
  141.                                              '  always DGROUP
  142.    RegsX.ax = &H4E00                         'Find First Matching Name
  143.  
  144.    DO
  145.       InterruptX &H21, RegsX, RegsX          'Call DOS
  146.  
  147.       IF RegsX.flags AND 1 THEN              'Error flag
  148.          EXIT DO                             'No more files
  149.       END IF
  150.  
  151.       SELECT CASE Attr%                      'Which attrs. to include?
  152.       CASE 16                                'Count only directories?
  153.          IF (ASC(DTA.Attr) \ 16) AND 1 THEN  'Is this one a directory?
  154.             IF ASC(DTA.FileName) <> 46 THEN  'Ignore "." and ".."
  155.                Count% = Count% + 1           'Found another dir name
  156.             END IF
  157.          END IF
  158.       CASE 0, 32                             'Count count only files?
  159.          Count% = Count% + 1                 'Found another file name
  160.       CASE 48                                'Count files & directories
  161.          Count% = Count% + 1
  162.       END SELECT
  163.  
  164.       RegsX.ax = &H4F00                      'Find next name service
  165.    LOOP
  166.  
  167.    FileCnt% = Count%                         'Assign value to function
  168. END FUNCTION
  169.  
  170. '***********************************************************************
  171. '* SUB LoadNames
  172. '*
  173. '* PURPOSE
  174. '*    Uses DOS ISR 21H, Function 1AH (DOS set DTA Service), Function 4EH
  175. '*    (Find First Matching Name), and Function 4FH (Find Next Matching
  176. '*    Name) to load the files matching FileSpec$ into an array.
  177. '***********************************************************************
  178. SUB LoadNames (FileSpec$, Array$(), Attr%) STATIC
  179.    Spec$ = FileSpec$ + CHR$(0)               'Needs to be ASCIIZ string
  180.  
  181.    NumFiles% = FileCnt%(Spec$, Attr%)        'Get # files matching Spec$
  182.    IF NumFiles% = 0 THEN                     'If there are none,
  183.       EXIT SUB                               '  exit
  184.    END IF
  185.  
  186.    REDIM Array$(1 TO NumFiles%)              'Allocate enough elements
  187.  
  188.    RegsX.dx = SADD(Spec$)                    'Filespec's address
  189.    RegsX.ds = VARSEG(Spec$)
  190.    RegsX.cx = Attr%
  191.    RegsX.ax = &H4E00                         'Find First Matching Name
  192.  
  193.    Count% = 0                                'Initialize the counter
  194.  
  195.    DO
  196.       InterruptX &H21, RegsX, RegsX          'Call DOS
  197.       IF RegsX.flags AND 1 THEN              'Error flag
  198.          EXIT DO                             'No more files
  199.       END IF
  200.  
  201.       Valid% = 0                             'Assume invalid
  202.  
  203.       SELECT CASE Attr%                      'Which attrs. to include?
  204.       CASE 16                                'Count only directories?
  205.          IF (ASC(DTA.Attr) \ 16) AND 1 THEN  'Is this one a directory?
  206.             IF ASC(DTA.FileName) <> 46 THEN  'Ignore "." and ".."
  207.                Valid% = -1                   'Found another dir name
  208.             END IF
  209.          END IF
  210.       CASE 0, 32                             'Count only files?
  211.          Valid% = -1                         'Found another file name
  212.       CASE 48                                'Count files & directories
  213.          Valid% = -1
  214.       END SELECT
  215.  
  216.       IF Valid% THEN                         'Add the file to array if
  217.          Count% = Count% + 1                 '  it's valid
  218.          Z% = INSTR(DTA.FileName, CHR$(0))   'Find terminating NUL
  219.          Array$(Count%) = LEFT$(DTA.FileName, Z% - 1) 'assign the name
  220.       END IF
  221.  
  222.       RegsX.ax = &H4F00                      'Find Next Matching Name
  223.    LOOP
  224. END SUB
  225.